home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / asyncom.arc / QRECV.BAS next >
Encoding:
BASIC Source File  |  1987-07-15  |  2.1 KB  |  106 lines
  1.     defint a-z
  2.     tv$=chr$(255)
  3.     nl$=chr$(0)
  4.     t$=" "
  5.     bf$=space$(512)
  6.     on error goto err.rtn
  7.  
  8. 1
  9.     open "com1:9600,n,8,1,rs,cs,ds,cd" as #1
  10.  
  11. begin:
  12.     cls
  13.     locate 5,20
  14.     print "QRECV - Asynchronous file transfer utility"
  15.     locate 10,10
  16.     print "Waiting . . ."
  17.  
  18. get.char:
  19.     if loc(1)=0 then _
  20.       if inkey$="" then _
  21.     goto get.char _
  22.       else _
  23.     close _
  24.     :cls _
  25.     :end
  26.     mid$(t$,1,1)=input$(1,#1)
  27.     if bm=0 then _
  28.       if t$<>tv$ then _
  29.     print t$; _
  30.     :goto get.char _
  31.       else _
  32.     bm=1 _
  33.     :c=0 _
  34.     :bl=3 _
  35.     :goto get.char
  36.     c=c + 1
  37.     mid$(bf$,c,1)=t$
  38.     cb=cb + asc(t$)
  39.     cb=cb-int(cb/256)*256
  40.     if c<bl then _
  41.       goto get.char
  42.     if bm=1 then _
  43.       bm=2 _
  44.       :cb$=left$(bf$,1) _
  45.       :bl=cvi(mid$(bf$,2,2)) _
  46.       :c=0 _
  47.       :cb=0 _
  48.       :bc=0 _
  49.       :locate 23,10 _
  50.       :print "Block length";bl _
  51.       :goto get.char
  52.     bm=0
  53.     if cb$ <> left$(mki$(cb),1) then _
  54.       locate 23,10 _
  55.       :print "Resend...";space$(10) _
  56.       :print #1, nl$; _
  57.       :goto get.char
  58.     if fm=0 then _
  59.       fl!=cvs(left$(bf$,4)) _
  60.       :fl$=mid$(bf$,5,bl-4) _
  61.       :gosub open.rtn
  62.       :fm=1 _
  63.       :tl!=0 _
  64.       :locate 10,5 _
  65.       :print "Receiving '";fl$;"', length:";fl!;"bytes,";int(fl!/512)+1;"blocks"
  66.       :print #1, tv$; _
  67.       :goto get.char
  68.     bc=bc+1
  69.     locate 23,40
  70.     print "Block";bc
  71.     for j=1 to bl
  72.       lset b$=mid$(bf$,j,1)
  73.       put #2
  74.     next
  75.     print #1, tv$;
  76.     tl!=tl!+bl
  77.     if tl!<fl! then _
  78.       goto get.char
  79.     fm=0
  80.     close 2
  81.     go to begin
  82.  
  83. open.rtn:
  84.     open fl$ as #2 len=1
  85.     if lof(2) > 0 then _
  86.       close 2 _
  87.       :kill f$ _
  88.       :goto open.rtn
  89.     field#2, 1 as b$
  90.     return
  91.  
  92. err.rtn:
  93.     if err=57 then _
  94.       bm=0 _
  95.       :locate 20,5 _
  96.       :print "Communications error - restarting" _
  97.       :close 1 _
  98.       :open "com1:9600,n,8,1,rs,cs,ds,cd" as #1 _
  99.       :print #1, nl$; _
  100.       :for j=1 to 500 _
  101.       :next _
  102.       :locate 20,5 _
  103.       :print space$(40) _
  104.       :resume get.char
  105.     on error goto 0
  106.